home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PRUS101 / FTIMER.PAS < prev    next >
Pascal/Delphi Source File  |  1994-12-19  |  10KB  |  373 lines
  1. UNIT FTIMER; { FIDO unit for handling 10 timers}
  2.  (***************************************************************************
  3.  
  4.             RELEASE 1.02 - as contained in the file PRUS101.LZH
  5.                 by Peter Holschbach, 2:2450/660.3, GERMANY
  6.  
  7.                --------------------------------------------
  8.                 organized for Fido's PASCAL related echoes
  9.                --------------------------------------------
  10.  
  11.      06/28/1994 to --/--/---- by Peter Holschbach, 2:2450/660.3, GERMANY
  12.  
  13.  
  14.            As far as third party copyrights are not violated this
  15.            source code is hereby placed to the public domain. Use
  16.            it whatever way you want, but use AT YOUR OWN RISK.
  17.  
  18.            In case you should modify the source rather send your
  19.            modifications to the unit's current organizer (see above for
  20.            NM address) than to spread it on your own. This will help to
  21.            keep the unit updated and grant a certain standard to all
  22.            other users as well.
  23.  
  24.            The unit is currently still under work. So it might greatly
  25.            benefit of your participation.
  26.  
  27.            Those who contributed to the following piece of source,
  28.            listed in alphabethical order:
  29.         ================================================================
  30.            Peter Holschbach ...
  31.         ================================================================
  32.            YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.
  33.  
  34.            Credits in your own programs are as welcome as unnecessary.
  35.  
  36.  ***************************************************************************)
  37.  
  38. {$I FDEFINE.DEF}
  39.  
  40. {.$DEFINE UseBios}
  41.  
  42. Interface
  43.  
  44. Const TicksPerSecond     = 18.20650864;
  45.       FastTicksPerSecond = 4.772727E6/4;
  46.  
  47. Var TimerHandle : Word;
  48.  
  49. {----------------------------------------------------------------------------}
  50.  
  51. Procedure DeInstallFastTimer;
  52. Function  GetFastTimerHandle : Word;
  53. Function  GetTimerHandle : Word;
  54. Function  GetFastTimeSec (Handle:Word) : Real;
  55. Function  GetTimeSec (Handle:Word) : LongInt;
  56. Function  GetTimeTicks (Handle:Word) : LongInt;
  57. Procedure InstallFastTimer;
  58. Function  ReadFastTimer : LongInt;
  59. Procedure StartFastTimer (Handle :Word);
  60. Procedure StartTimer (Handle :Word);
  61. Procedure StopTimer (Handle :Word);
  62. Function  UnGetFastTimerHandle (Handle :Word): Boolean;
  63. Function  UnGetTimerHandle (Handle :Word): Boolean;
  64.  
  65. {----------------------------------------------------------------------------}
  66.  
  67. Implementation
  68.  
  69.  
  70. Uses FChkOs;
  71.  
  72. Const
  73.          TicksPerDay    = $1800B2;
  74.  
  75.          WindowsEnhanced : Boolean = FALSE;
  76. Type
  77.       TimeAccessRec = Record
  78.           Case Word of
  79.             1 : (LSW,MSW:Word);
  80.             0 : (LWord : LongInt);
  81.           End;
  82.  
  83. Const  MaxTimerHandle = 10;
  84.        MaxLongx2 = 4294967296.0; (* max. positive number of longint * 2 *)
  85.        FastTimeSecOffset : Real = 0.0; (* Runtime of StartFastTimer and
  86.                                           GetFastTimeSec                *)
  87.  
  88.        FreeHandles    : Array [1..MaxTimerHandle] of Boolean =
  89.              (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE);
  90.  
  91.        FreeFastHandles    : Array [1..MaxTimerHandle] of Boolean =
  92.              (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE);
  93.  
  94.  
  95. Var
  96.      StartTimeField : Array [1..MaxTimerHandle] of LongInt;
  97.      StartFastTimeField : Array [1..MaxTimerHandle] of LongInt;
  98.  
  99. {----------------------------------------------------------------------------}
  100. Procedure DeInstallFastTimer;
  101.  
  102. Begin
  103.   ASM
  104.     MOV AL,$36
  105.     OUT $43,AL
  106.     MOV AL,00
  107.     OUT $40,AL
  108.     OUT $40,AL
  109.   End;
  110. End;
  111.  
  112. {----------------------------------------------------------------------------}
  113.  
  114. Procedure StartFastTimer (Handle : Word);
  115.  
  116.  
  117. Begin
  118.   StartFastTimeField [Handle] := ReadFastTimer;
  119. End;
  120.  
  121. {----------------------------------------------------------------------------}
  122. Procedure StartTimer (Handle : Word);
  123. { Original author: Peter Holschbach }
  124.  
  125. Var Time : TimeAccessRec;
  126.  
  127.  
  128. Begin
  129.   TimerHandle := Handle;
  130.   If Handle = 0 then Begin
  131.     Handle := GetTimerHandle;
  132.     If Handle <> 0 then TimerHandle := Handle
  133.     Else Exit;
  134.   End;
  135. {$IFDEF UseBios}
  136.   ASM
  137.     MOV AX,00           (* SubFunction GetTime *)
  138.     INT $1A             (* Bios-Funktion *)
  139.     MOV Time.LSW,DX
  140.     MOV Time.MSW,CX
  141.   End;
  142. {$ELSE}
  143.   ASM
  144.     MOV  AX,$40
  145.     PUSH AX
  146.     POP  ES
  147.     CLI
  148.     MOV DX,ES:[$6C]
  149.     MOV CX,ES:[$6E]
  150.     STI
  151.     MOV Time.LSW,DX
  152.     MOV Time.MSW,CX
  153.   End;
  154. {$ENDIF}
  155.   StartTimeField [Handle] := Time.LWord;
  156. End;
  157.  
  158. {----------------------------------------------------------------------------}
  159.  
  160. Procedure StopTimer (Handle :Word);
  161. { Original author: Peter Holschbach }
  162.  
  163. Begin
  164.   StartTimeField [Handle] := $FFFF;
  165. End;
  166.  
  167. {----------------------------------------------------------------------------}
  168.  
  169. Function GetTimeTicks (Handle : Word): LongInt;
  170. { Original author: Peter Holschbach }
  171.  
  172. Var Time  : TimeAccessRec;
  173.     Ticks : LongInt;
  174.  
  175. Begin
  176. {$IFDEF UseBios}
  177.    ASM
  178.     MOV AH,00           (* SubFunction GetTime *)
  179.     INT $1A             (* Bios-Funktion *)
  180.                         (* CX,DX = 32Bit Counter *)
  181.     MOV Time.LSW,DX
  182.     MOV Time.MSW,CX
  183.   End;
  184. {$ELSE}
  185.   ASM
  186.     MOV  AX,$40
  187.     PUSH AX
  188.     POP  ES
  189.     CLI
  190.     MOV DX,ES:[$6C]
  191.     MOV CX,ES:[$6E]
  192.     STI
  193.     MOV Time.LSW,DX
  194.     MOV Time.MSW,CX
  195.   End;
  196. {$ENDIF}
  197.   If (Time.LWord < StartTimeField [Handle]) then Begin
  198.      Ticks := TicksPerDay - StartTimeField [Handle] + Time.LWord;
  199.   End
  200.   Else Begin
  201.     Ticks := Time.LWord - StartTimeField [Handle];
  202.   End;
  203.   GetTimeTicks := Ticks;
  204. End;
  205.  
  206. {----------------------------------------------------------------------------}
  207.  
  208. Function  GetFastTimeSec (Handle:Word) : Real;
  209.  
  210. Var TmpValue : LongInt;
  211.     StartReal,
  212.     StopReal : Real;
  213.  
  214. Begin
  215.   TmpValue := ReadFastTimer;
  216.  
  217.   (* longint is to short for calculate the time, so we must use real *)
  218.   If StartFastTimeField [Handle] < 0 then  (* we need a unsigned number *)
  219.     StartReal := MaxLongx2 + StartFastTimeField [Handle]
  220.   Else
  221.     StartReal := StartFastTimeField [Handle];
  222.  
  223.   If TmpValue < 0 then
  224.     StopReal  := MaxLongx2 + TmpValue
  225.   Else
  226.     StopReal  := TmpValue;
  227.  
  228.   GetFastTimeSec := (StopReal - StartReal - FastTimeSecOffset) / FastTicksPerSecond;
  229. End;
  230.  
  231. {----------------------------------------------------------------------------}
  232. Function GetTimeSec (Handle:Word) : LongInt;
  233. { Original author: Peter Holschbach }
  234.  
  235. Begin
  236.   GetTimeSec := GetTimeTicks (Handle) * 10 div 182;
  237. End;
  238.  
  239. {----------------------------------------------------------------------------}
  240. Function  GetFastTimerHandle : Word;
  241. { Original author: Peter Holschbach }
  242. Var L :  Word;
  243.  
  244. Begin
  245.   L := 0;
  246.   Repeat
  247.     Inc (L)
  248.   Until (L > MaxTimerHandle) Or Not FreeFastHandles [L];
  249.   If L > MaxTimerHandle Then GetFastTimerHandle := 0
  250.   else Begin
  251.     FreeFastHandles [L] := True;
  252.     GetFastTimerHandle := L;
  253.   End;
  254. End;
  255.  
  256.  
  257. {----------------------------------------------------------------------------}
  258. Function  GetTimerHandle : Word;
  259. { Original author: Peter Holschbach }
  260. Var L :  Word;
  261.  
  262. Begin
  263.   L := 0;
  264.   Repeat
  265.     Inc (L)
  266.   Until (L > MaxTimerHandle) Or Not FreeHandles [L];
  267.   If L > MaxTimerHandle Then GetTimerHandle := 0
  268.   else Begin
  269.     FreeHandles [L] := True;
  270.     GetTimerHandle := L;
  271.   End;
  272. End;
  273.  
  274. {----------------------------------------------------------------------------}
  275. Procedure InstallFastTimer;
  276.  
  277.   Function GetFastTimer : LongInt;
  278.  
  279.   Begin
  280.     GetFastTimer := ReadFastTimer;
  281.   End;
  282.  
  283.  
  284. Var a,b : LongInt;
  285.     ar,br : Real;
  286.     tmpReal : Real;
  287.     L       : Word;
  288.  
  289. Begin
  290.   ASM
  291.     MOV AL,$34   (* we use timer 0 in mode 2 *)
  292.     OUT $43,AL
  293.     MOV AL,00
  294.     OUT $40,AL
  295.     OUT $40,AL
  296.   End;
  297.   TmpReal := 0;
  298.   For L:= 1 to 10 do Begin
  299.     FastTimeSecOffset := 00;
  300.     a:=  GetFastTimer;
  301.     b := GetFastTimer;
  302.     if a < 0 then ar := MaxLongx2 + a
  303.     else ar := a;
  304.  
  305.     if b < 0 then br := MaxLongx2 + b
  306.     else br := b;
  307.     tmpReal := TmpReal + br - ar;
  308.     If L <> 1 then tmpReal := TmpReal / 2;
  309.   End;
  310.   FastTimeSecOffset := TmpReal;
  311. End;
  312.  
  313. {----------------------------------------------------------------------------}
  314. Function ReadFastTimer : LongInt;
  315.  
  316. Var TmpValue : TimeAccessRec;
  317.  
  318. Begin
  319.   ASM
  320.       MOV   AX,$40      (* BIOS-RAM Segment Adress *)
  321.       MOV   ES,AX       (* Set ES to BIOS RAM *)
  322.       MOV   AL,$00
  323.  
  324.       CLI               (* Disable all Interrupts *)
  325.       OUT   $43,AL      (* freez timer 0 *)
  326.       MOV   CX,ES:[$6C] (* CX = LSW of sys timer *)
  327.       STI               (* enable Interrupts *)
  328.  
  329.       IN    AL,$40      (* Read LSB of timer 0 *)
  330.       MOV   BL,AL
  331.       IN    AL,$40      (* Read MSB of timer 0 *)
  332.       MOV   BH,Al       (* BX = timer 0 *)
  333.                         (* enable Interrupts *)
  334.       NOT   BX          (* timer 0 is a descending counter, we need a
  335.                            ascending counter   *)
  336.  
  337.       CMP   CX,ES:[$6C] (* if an interrupt had been occured, the systimer
  338.                            is not equal to the number we read bevor   *)
  339.       JE    @NoIntPending   (* no interrupt, no problem *)
  340.       CMP   BX,$FF          (* was the Interrupt pending after frozen the timer *)
  341.       JAE   @NoIntPending   (* bigger or equal -> no *)
  342.       INC   CX              (* we must correct the systimer *)
  343. @NoIntPending:
  344.       MOV   TmpValue.LSW,BX
  345.       MOV   TmpValue.MSW,CX
  346.     End;
  347.      ReadFastTimer := TmpValue.LWord;
  348. End;
  349.  
  350. {----------------------------------------------------------------------------}
  351.  
  352. Function  UnGetFastTimerHandle (Handle :Word): Boolean;
  353. { Original author: Peter Holschbach }
  354.  
  355. Begin
  356.   UnGetFastTimerHandle := FreeFastHandles [Handle];
  357.   FreeFastHandles [Handle] := False;
  358. End;
  359.  
  360. {----------------------------------------------------------------------------}
  361.  
  362. Function  UnGetTimerHandle (Handle :Word): Boolean;
  363. { Original author: Peter Holschbach }
  364.  
  365. Begin
  366.   UnGetTimerHandle := FreeHandles [Handle];
  367.   FreeHandles [Handle] := False;
  368. End;
  369.  
  370. {----------------------------------------------------------------------------}
  371.  
  372. End.
  373.